Rem THE VB MEMORY LANE by Costas Kitsos

DefInt A-Z

Dim AHINCR As Integer

Sub Form_Load ()
    AHINCR = GetProcAddress(GetModuleHandle("KERNEL"), "__AHINCR") And &HFFFF&
End Sub

Sub Mnu_LongInteger_Click ()
    
    Cls

    Dim MemHandle As Integer, wSize  As Integer
    Dim lpAddress As Long, dwData As Long
    Dim dwIndex As Long, dwBytes As Long
    
    Const Max = 70000
    
    ' Demo a 70,000 element Array of Long Integers

    wSize = Len(dwData) ' wSize equals the size of a long Integer (4 bytes)
   
    MemHandle = GlobalAlloc(GHND, Max * wSize)

    If MemHandle = 0 Then Exit Sub    ' If our request failed then exit

	Print "Allocated"; Max * wSize; " bytes"
	Print

    lpAddress = GlobalLock(MemHandle) ' get a pointer to the memory block

	
	Print "Writing Data to" + Str$(Max) + " Element Array of Long Integers"
	Print

    wSel = lpAddress \ &H10000  ' calculate the Selector portion of the Address

    For dwData = 0 To Max - 1 Step 100 ' write some data
	
	dwBytes = dwData * wSize
	Call hmemcpy(ByVal (((wSel + (((dwBytes \ &H10000) * AHINCR))) * &H10000) + (dwBytes And &HFFFF&)), dwData, wSize)

    Next

    dwIndex = 60000

	Print "Reading Data from element:", dwIndex

     dwBytes = dwIndex * wSize
     Call hmemcpy(dwData, ByVal (((wSel + (((dwBytes \ &H10000) * AHINCR))) * &H10000) + (dwBytes And &HFFFF&)), wSize)
    
	Print "Data in Element"; dwIndex; " = ", dwData

	Print
	Print "Freeing Memory"

    Ok = GlobalUnlock(MemHandle)
    Ok = GlobalFree(MemHandle)

	Print "Done"
	
End Sub

Sub Mnu_UserType_Click ()

    Cls

    ' Demo a User Defined Type array of 2,000 elements

    Dim StoreRec As VideoType

    RecordsSize& = 2000 * Len(StoreRec) ' 256,000 bytes
    
    MemHandle = GlobalAlloc(GHND, RecordsSize&)

    If MemHandle = 0 Then Exit Sub    ' If our request failed then exit

	Print "Allocated "; RecordsSize&; " bytes"
	Print

    wSel = GlobalHandleToSel(MemHandle) ' get a selector

    ' some data to write

    StoreRec.Index = 8731
    StoreRec.Title = "Silence of the Lambs"
    StoreRec.Length = 90
    StoreRec.IsRented = 1
    StoreRec.Customer = "Gus Tomer"
    StoreRec.CustomerNo = 33

    dwOffset& = 1999 * Len(StoreRec)
    dwcb& = Len(StoreRec)

    Bytes& = MemoryWrite(wSel, dwOffset&, StoreRec, dwcb&)
    
    Print "Wrote:"; Bytes&; " bytes at Index 1999": Print

    ' Ready to read it back now.
    
    ' erase the record to prove that it worked.
    StoreRec.Index = 0
    StoreRec.Title = ""
    StoreRec.Length = 0
    StoreRec.IsRented = 0
    StoreRec.Customer = ""
    StoreRec.CustomerNo = 0
    
    ' read the record

    Bytes& = MemoryRead(wSel, dwOffset&, StoreRec, dwcb&)

    Print "Read:"; Bytes&; " bytes at index 1999": Print

    Print "StoreRec.Index = "; StoreRec.Index
    Print "StoreRec.Title = "; StoreRec.Title
    Print "StoreRec.Length = "; StoreRec.Length
    Print "StoreRec.IsRented = "; StoreRec.IsRented
    Print "StoreRec.Customer = "; StoreRec.Customer
    Print "StoreRec.CustomerNo = "; StoreRec.CustomerNo
    Print

    Ok = GlobalFree(MemHandle)

    Print "Done"

End Sub

Sub Mnu_TimeTest_Click ()
    
    Cls

    Dim MemHandle As Integer, wSize As Integer
    Dim lpAddress As Long, dwIndex As Long
    Dim dwData As Long, dwBytes As Long
    
    Const Max = 100000
    ' Demo a 100,000 element Array of Long Integers

    wSize = Len(dwData)        ' wSize equals the size of a long integer (4 bytes)
   
    MemHandle = GlobalAlloc(GHND, (Max * wSize))

    If MemHandle = 0 Then Exit Sub      ' If our request failed then exit

	Print "Allocated"; Max * wSize; " bytes"
	Print

    lpAddress = GlobalLock(MemHandle)   ' get a pointer to the memory block

	Print "Writing Data with hmemcpy to" + Str$(Max) + " Element Array of Long Integers"

    StartTime& = GetTickCount()

    wSel = lpAddress \ &H10000  ' calculate the Selector portion of the Address

    For dwData = 0 To Max - 1 Step 50
	
	dwBytes = dwData * wSize
	Call hmemcpy(ByVal (((wSel + (((dwBytes \ &H10000) * AHINCR))) * &H10000) + (dwBytes And &HFFFF&)), dwData, wSize)

    Next

    EndTime& = GetTickCount()

	Print "hmemcpy Time = "; Str$(EndTime& - StartTime&); " milliseconds"
	Print
	Print "Writing Data with ToolHelp to" + Str$(Max) + " Element Array of Long Integers"

    wSel = GlobalHandleToSel(MemHandle)

    StartTime& = GetTickCount()

    For dwData = 0 To Max - 1 Step 50
	
	dwBytes = MemoryWrite(wSel, wSize * dwData, dwData, wSize)
	
    Next

    EndTime& = GetTickCount()

	Print "ToolHelp Time = "; Str$(EndTime& - StartTime&); " milliseconds"
	
    Ok% = GlobalUnlock(MemHandle)
    Ok% = GlobalFree(MemHandle)

	Print
	Print "Done"

End Sub